home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pistol.zip / PISTC.C < prev    next >
Text File  |  1987-08-20  |  3KB  |  119 lines
  1. /*********************************************************/
  2. /*                             */
  3. /* PISTOL-Portably Implemented Stack Oriented Language     */
  4. /*            Version 1.3             */
  5. /* (C) 1982 by    Ernest E. Bergmann             */
  6. /*        Physics, Building #16             */
  7. /*        Lehigh Univerisity             */
  8. /*        Bethlehem, Pa. 18015             */
  9. /*                             */
  10. /* Permission is hereby granted for all reproduction and */
  11. /* distribution of this material provided this notice is */
  12. /* is included.                         */
  13. /*                             */
  14. /*********************************************************/
  15.  
  16. /* third module, February, 1982 */
  17.  
  18. #include "bdscio.h"
  19. #include "pistol.h"
  20.  
  21. char *slit() /* emplaces string lit.,returns ^ to its start */
  22. {char i,*start; /*Feb 13: elim. Pc2,len*/
  23.     Pc=start=ram[-4].pc; Pc++;
  24.     *start=*ram[-4].pc -1;
  25.     Pc++; ram[-4].pc++;
  26.     for(i=*start; i ; Pc++,ram[-4].pc++,i--)
  27.         *ram[-4].pc=*Pc ;
  28.     return(start);
  29. }
  30.  
  31. char *longstring() /* Feb 13 eliminate Pc */
  32. {char len,*start;
  33.     if(*ram[-18].pc != '"') abort();
  34.     Pc2=start=ram[-4].pc; Pc2++;
  35.     len=0;
  36.     ram[-15].pc=ram[-18].pc+1;
  37.     while(*ram[-15].pc != NEWLINE && *ram[-15].pc != '"')
  38.         {len++; *Pc2=*ram[-15].pc; Pc2++; nextch(); }
  39.     nextch();
  40.     *start=len;
  41.     ram[-4].pc=Pc2;
  42.     return(start);
  43. }
  44.  
  45. int digit(d)
  46. char d;
  47. {if(d<='9') return(d-'0');
  48. if(d<'A') return(-1);
  49. if(d<='Z') return(10-'A'+d);
  50. return(-1);
  51. }
  52.  
  53. char convert(ptkn,base,Pval)
  54. char *ptkn,base;
  55. int *Pval;
  56. {char *tend;
  57.  int val,d;
  58.     val=0; ram[-10].in=1; tend=*ptkn + ptkn +1;
  59.     ptkn++ ;
  60.     if(*ptkn=='+') ptkn++;
  61.     else if(*ptkn=='-'){ptkn++; ram[-10].in=-1;}
  62.     d=digit(*ptkn);
  63.     while((d>-1)&&(ptkn<tend)&&(d<base))
  64.     {    val=base*val+d;
  65.         ptkn++;d=digit(*ptkn);
  66.     }
  67.     *Pval=ram[-10].in*val;
  68.     if(ptkn==tend) return(TRU);
  69.     else return(FALS);
  70. }
  71.  
  72. compline() /* Feb 13 remove Pc */
  73. {int *pad;
  74. if((!ram[-11].in)||ram[-13].in) prompt();
  75. if(ram[-11].in&&(ram[-11].in<MAXLINNO))
  76.     {push(ram[-11].in);interpret(ram[-28].in);
  77.     ram[-11].in++;
  78.     }
  79. else getline();
  80. ignrblnks();
  81. while(*ram[-15].pc != NEWLINE)
  82.     {ram[-18].pc=ram[-15].pc;
  83. intoken();
  84. pad=find(ram[-4].in);
  85.     if(pad) interpret(pad-1);
  86.     else    {if(convert(ram[-4].in,ram[-1].in,&val))
  87.             {compile(LIT);compile(val);}
  88.         else    {if(Pc=ram[-4].pc+1,*Pc=='\'')
  89.                 {pad=slit();compile(STRLIT);
  90.                 compile(pad);}
  91.             else if(*Pc=='"')
  92.                 {pad=longstring();
  93.                 compile(STRLIT);compile(pad);}
  94.             else if(ram[-51].in)
  95.                 interpret(ram[51].in);
  96.             else{/*token couldn't be deciphered*/
  97.                 ram[-14].in=TRU;
  98.                 if(ram[-11].in&&(!ram[-13].in))
  99.                 {if(ram[-24].in) carret();
  100.                  message(&strings[LINEBUF]);
  101.                 }
  102.                 message(ram[-4].in);
  103.                 printf(" ?\n");
  104.                 if(ram[-12].in)fprintf(" ?\n",
  105.                         list);
  106.                 abort();
  107.                 }
  108.             }
  109.         }
  110.     ignrblnks();
  111.     }
  112. }
  113.  
  114. TRU);
  115.     else return(FALS);
  116. }
  117.  
  118. compline() /* Feb 13 remove Pc */
  119. {int *